home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / DITHER.INC < prev    next >
Text File  |  1991-09-11  |  3KB  |  101 lines
  1. {routines and types for doing dithering in colour and in monochrome }
  2.  
  3.  
  4. type dithtype = array[1..4] of integer;
  5.  
  6. const Dither: array[1..4] of dithtype = (
  7.    (11,  5, 15,  1),
  8.    (16,  6,  2,  9),
  9.    ( 3, 10, 14,  8),
  10.    ( 7, 12,  4, 13));
  11.  
  12.  
  13. procedure DITHPLOT (X, Y, Ishade, Color1, Color2: integer);
  14. { dithered pixel plot command }
  15. var Xmod, Ymod: integer;    { X & Y coords modulo 4. This is the place in }
  16.                             { the dither matrix }
  17. begin
  18.   Xmod := X mod 4 + 1;
  19.   Ymod := Y mod 4 + 1;
  20.   if (Ishade >= Dither[Xmod][Ymod]) then
  21.     gplot (X, Y, Color1)
  22.   else
  23.     gplot (X, Y, Color2);
  24. end; { procedure DITHPLOT }
  25.  
  26.  
  27. procedure DITHDRAW (X1, X2, Y, Ishade, Color1, Color2: integer);
  28. { dithered horizontal line drawing routine }
  29. var X:          integer;        { X coord along line }
  30. var Xmod, Ymod: integer;    { X & Y coords modulo 4. This is the place in }
  31.                             { the dither matrix }
  32.  
  33. begin
  34.   Ymod := Y mod 4 + 1;
  35.   for X := X1 to X2 do begin
  36.     Xmod := X mod 4 + 1;
  37.     if (Ishade >= Dither[Xmod][Ymod]) then
  38.       gplot (X, Y, Color1)
  39.     else
  40.       gplot (X, Y, Color2);
  41.   end; { for X }
  42. end; { procedure DITHDRAW }
  43.  
  44.  
  45. procedure INTRPLOT (X, Y, Mat: integer; Shade: real);
  46. { Plot procedure with interpolated shading }
  47. var Pcolor: integer;        { color to set pixel }
  48.     Fmod: integer;          { mod for fill pixel setting }
  49.     Ishade: integer;        { integer version of shade (0..64) for dithering }
  50.     Tshade: real;           { temp for Shade }
  51.     Color1, Color2: integer;{ 2 colors that bracket the shade }
  52.  
  53. begin
  54.   if (Dorandom) then
  55.     Tshade := Shade + Random * Randshade
  56.   else
  57.     Tshade := Shade;
  58.   if (Ncolors >= 3) and (Mono) then begin
  59.     { Use system's colors as shades of grey }
  60.     colormod (Tshade, grSys, Color[Mat], Pcolor, Fmod);
  61.     { Now finally set the pixel to the desired shade }
  62.     shplot (X, Y, Pcolor, Fmod);
  63.   end else begin
  64.     { Use dithered shading }
  65.     findcolors (Mat, Color[Mat], Tshade, Color1, Color2);
  66.     Ishade := trunc (Tshade * 16.0);
  67.     { Make sure the color is legitimate }
  68.     dithplot (X, Y, Ishade, Color1, Color2);
  69.   end; { if Ncolors... }
  70. end; { procedure INTRPLOT }
  71.  
  72.  
  73. procedure INTRDRAW (X1, X2, Y, Mat: integer; Shade1, Shade2: real);
  74. { Draw procedure with interpolated shading from point 1 to point 2 }
  75. var X: integer;
  76.     Shfact: real;           { factor for shade interpolation }
  77.     Firstsh: boolean;       { flag first time through }
  78.     Shade: real;            { shade at pixel }
  79.  
  80. begin
  81.   Firstsh := TRUE;
  82.   if (X2 = X1) then
  83.     Shfact := 0.0
  84.   else
  85.     Shfact := (Shade2 - Shade1) / (X2 - X1);
  86.  
  87.   for X := X1 to X2 do begin
  88.     if (Shfact = 0.0) then
  89.       if (Firstsh) then begin
  90.         Shade := Shade1;
  91.         Firstsh := FALSE;
  92.       end else
  93.         Shade := Shade2
  94.     else
  95.       Shade := Shade1 + (X-X1) * Shfact;
  96.  
  97.     { Plot this pixel with shading }
  98.     intrplot (X, Y, Mat, Shade);
  99.   end; { for X }
  100. end; { procedure INTRDRAW }
  101.